Imports Microsoft.VisualBasic.VBMath

Module modEntryptDecrypt
    '**************************************
    ' Name: Algorithum Encryption and Decryp
    '     tion
    ' Description:This code will take text,
    '     and encrypt it in Algorithum Encryption.
    '     What it does is randomly create 4 keys,
    '     each one 1 char long. No password needed
    '     to encrypt the text, it creates its own
    '     and stores it within the encrypted text.
    '     Virtualy impossible to crack because the
    '     output encryption is rarely the same. Fo
    '     r example, a string that says "test" wil
    '     l be 8 charachters long, and almost neve
    '     r the same. Or a string that says "testi
    '     ng" will be 11 charachters long. The key
    '     to encrypt and decrypt is stored at the
    '     beginning and the end of the output maki
    '     ng it almost impossible to crack.
    ' By: Pinak Ranjan Sahoo

    Public Function TEncrypt(ByVal iString) As String
        Dim Q As String, F As String
        Dim a As Long, B As Long, c As Long, d As Long, e As Long, X As Long

        TEncrypt = ""

        Try
            Q = ""
            a = randomnumber(9) + 32
            B = randomnumber(9) + 32
            c = randomnumber(9) + 32
            d = randomnumber(9) + 32
            Q = Chr(a) & Chr(c) & Chr(B)
            e = 1
            For X = 1 To Len(iString)
                F = Mid(iString, X, 1)
                If e = 1 Then Q = Q & Chr(Asc(F) + a)
                If e = 2 Then Q = Q & Chr(Asc(F) + c)
                If e = 3 Then Q = Q & Chr(Asc(F) + B)
                If e = 4 Then Q = Q & Chr(Asc(F) + d)
                e = e + 1
                If e > 4 Then e = 1
            Next X
            Q = Q & Chr(d)
            TEncrypt = Q
        Catch ex As Exception
            MessageBox.Show(ex.Message, gstrMessage, MessageBoxButtons.OK, MessageBoxIcon.Error)
            AddErrorLog("Error " & Err.Number & " (" & Err.Description & ") in Procedure " & _
                Reflection.MethodBase.GetCurrentMethod.Name & " Of modEntryptDecrypt")
        End Try
    End Function

    Function TDecrypt(ByVal iString)
        Dim Q As String, F As String, zz As String, txt As String, txt2 As String
        Dim a As String, B As String, c As String, d As String, e As Long, X As Long

        TDecrypt = ""

        Try
            Q = ""
            zz = Left(iString, 3)
            a = Left(zz, 1)
            B = Mid(zz, 2, 1)
            c = Mid(zz, 3, 1)
            d = Right(iString, 1)
            a = Int(Asc(a)) 'key 1
            B = Int(Asc(B)) 'key 2
            c = Int(Asc(c)) 'key 3
            d = Int(Asc(d)) 'key 4
            txt = Left(iString, Len(iString) - 1)
            txt2 = Mid(txt, 4, Len(txt)) 'encrypted text
            e = 1

            For X = 1 To Len(txt2)
                F = Mid(txt2, X, 1)
                If e = 1 Then Q = Q & Chr(Asc(F) - a)
                If e = 2 Then Q = Q & Chr(Asc(F) - B)
                If e = 3 Then Q = Q & Chr(Asc(F) - c)
                If e = 4 Then Q = Q & Chr(Asc(F) - d)
                e = e + 1
                If e > 4 Then e = 1
            Next X
            TDecrypt = Q

        Catch ex As Exception
            MessageBox.Show(ex.Message, gstrMessage, MessageBoxButtons.OK, MessageBoxIcon.Error)
            AddErrorLog("Error " & Err.Number & " (" & Err.Description & ") in Procedure " & _
                Reflection.MethodBase.GetCurrentMethod.Name & " Of modEntryptDecrypt")
        End Try
    End Function

    Private Function randomnumber(ByVal finished) As Long
        Randomize()
        randomnumber = Int((Val(finished) * Rnd()) + 1)
    End Function
End Module
